-----------------------------------------------------------------------------
-- |
-- Maintainer  :  joost.visser@di.uminho.pt, alcino@di.uminho.pt
-- Stability   :  experimental
-- Portability :  portable
--
-- Example of format evolution and data mapping, using a datatype
-- for music albums.
--
-----------------------------------------------------------------------------

{-# OPTIONS -fglasgow-exts #-}

module Data.Transform.CoupledAlbumHUnit where

import HUnit
import Data.Transform.Coupled
import Data.List as List

-----------------------------------------------------------------------------

main = runTestTT . TestList . map TestCase $ [queries,migration,test1]


-----------------------------------------------------------------------------
-- * Set up the format and some data

-- | The album format, encoded in Haskell.

albums :: Type Albums
albums = List (Tag "Album" (Prod String (Prod String String)))
            
type Albums = [Album]
type Album = (ASIN,(Title,Artist))
type ASIN = String
type Title = String
type Artist = String

-- | Adding a field: track list retrieved from some data source.
addTracks = once (inside "Album" (addinfo (List String) aux))
    where aux :: Query [String]
          aux (Prod String _) = COMP String (FUN "graceNote" graceNote) FST

-- | Looking up track listings from a database such as GraceNote.
graceNote :: String -> [String]
graceNote asin = maybe [] id $ List.lookup asin db
  where
    db = [ ("B000002UB2",
            ["Come Together","Something","Maxwell's Silver Hammer",
             "Oh! Darling","Octopus's Garden","I Want You (She's So Heavy)",
             "Here Comes the Sun","Because","You Never Give Me Your Money",
             "Sun King","Mean Mr. Mustard","Polythene Pam",
             "She Came in Through the Bathroom Window","Golden Slumbers",
             "Carry That Weight","End","Her Majesty"])
         , ("B000002HCO",
            ["Human Behaviour","Crying","Venus As A Boy",
             "There's More To Life Than This - Recorded Live At The Milk Bar Toilets",
             "Like Someone In Love","Big Time Sensuality","One Day","Aeroplane",
             "Come To Me","Violently Happy","The Anchor Song"
            ])
         ]

-----------------------------------------------------------------------------
-- * Test run

albums' = List (Tag "Album" (Prod (Prod String (Prod String String)) (List String)))
rdb = (Map Int (Prod String (Prod String String)))
rdb' = Prod (Map Int (Prod String (Prod String String))) (Map (Prod Int Int) String)

queries = do
  let getArtistsPF = LIST (COMP typeof SND SND) :: PF (Albums -> [Artist])

  -- Evolving and mapping.
  let evolve = addTracks
  let tordb = removetags >>> flatten

  let (Just vw1) = evolve albums
  let (Just vw2) = tordb albums'
  {-
  putStrLn $ "Adding track info gives: "++showType vw1
  putStrLn $ "Relational mapping gives: "++showType vw2
  -}
  let (Just (to,from)) = unView vw1 albums'
  let (Just (to2,from2)) = unView vw2 rdb'
  
  -- Composing backward mapping and query on original format
  let query1 = COMP albums getArtistsPF from
  let query2 = COMP albums getArtistsPF (COMP albums' from from2)
  
--  putStrLn $ "query1 = "++show query1
  let Just opt1 = reduceMaybe optimize typeof query1
  assertEqual "Should optimize" (LIST (SND .*. SND .*. FST)) opt1
  
--  putStrLn $ "query2 = "++show query2
  let Just opt2 = reduceMaybe optimize typeof query2
  assertEqual "Should optimize" (ELEMS .*. MAP (SND .*. SND) .*. FST) opt2

test1 :: IO ()
test1 = do
   let (Just evolvedFormat) = addTracks albums
   assertEqual "" (show albums') (showType evolvedFormat)




migration = 
    do let evolve = addTracks
	   tordb = removetags >>> flatten
           (Just vw1) = tordb albums
	   (Just vw2) = (evolve >>> tordb) albums
       -- putStrLn $ "\nrdb1 = " ++ showType vw1
       -- putStrLn $ "\nrdb2 = " ++ showType vw2   
       let (Just (to1,fro1)) = unView vw1 rdb
	   (Just (to2,fro2)) = unView vw2 rdb'
	   to = COMP typeof to2 fro1
	   iso1 = COMP typeof fro1 to1
	   iso2 = COMP typeof fro2 to2
	   inv1 = COMP typeof to1 fro1
	   inv2 = COMP typeof to2 fro2
       -- putStrLn $ "\nto  = "++show to
       simplify False optimize to
       let Just iso1' = reduceMaybe optimize typeof iso1
       assertEqual "Should optimize" ID iso1'
       let Just iso2' = reduceMaybe optimize typeof iso2
       assertEqual "Should optimize" ID iso2'
       let Just inv1' = reduceMaybe optimize typeof inv1
       assertEqual "Should optimize" (LIST2MAP .*. ELEMS) inv1'
       -- putStrLn $ "\ninv2  = "++show inv2
       simplify False optimize inv2
       
       return ()



-----------------------------------------------------------------------------
